﻿module HtmlScanner

open System
open System.Text.RegularExpressions
open HtmlUnescaper


type Attribute = 
    | Attribute of string * string

type Token (text) = 
    member this.text = text

type TextToken (cdata : string) = 
    inherit Token(cdata)

type StartTag (text:string, attributes:Attribute list) = 
    inherit Token(text)
    member this.tagName = text.ToLowerInvariant()
    member this.attributes =  Map.ofList [for (Attribute(name,value)) in attributes -> (name.ToLowerInvariant(),value)]

type EndTag (text:string) = 
    inherit Token(text)
    member this.tagName = text.ToLowerInvariant()

type Scanner(src:string) =
    let src = src
    let mutable pos = 0
    member this.scan(re:Regex) =
        let m = re.Match(src, pos)
        if m.Success then pos <- m.Index + m.Length
        m
    member this.atEnd() = pos = src.Length

let consumeTagEnd(scanner:Scanner) =
    scanner.scan(Regex("""
    \G # anchor at startpos
    .*? # consume garbage
    >    
    """, RegexOptions.ExplicitCapture ||| RegexOptions.IgnorePatternWhitespace ||| RegexOptions.Singleline)) |> ignore    

let scanTagName(scanner:Scanner) =
    let m = scanner.scan(Regex("""
    \G # anchor at startpos
    (?<name>\w+)
    \s* # consume trailing whitespace
    """, RegexOptions.ExplicitCapture ||| RegexOptions.IgnorePatternWhitespace ||| RegexOptions.Singleline))
    m.Groups.["name"].Value

let rec scanAttributes(scanner:Scanner) =
    let r = Regex("""\G     # anchor at startpos
        (?<name>\w+)
        (?<value>
            \s* = \s*
          (
              (?<quotedValue2>"(?<string2>[^"]*)")
            | (?<quotedValue1>'(?<string1>[^']*)')
            | (?<unquotedValue>[^'">\s]+)
          )
        )?
        \s* # consumes trailing space
    """, RegexOptions.ExplicitCapture ||| RegexOptions.IgnorePatternWhitespace ||| RegexOptions.Singleline)
    let m = scanner.scan(r)
    if m.Success 
    then 
        let name = m.Groups.["name"].Value
        let value = 
            if m.Groups.["value"].Success 
            then
                let unescapedValue =
                    if m.Groups.["quotedValue1"].Success then m.Groups.["string1"].Value 
                    elif m.Groups.["quotedValue2"].Success then m.Groups.["string2"].Value 
                    else m.Groups.["unquotedValue"].Value 
                (unescape unescapedValue).Trim()
            else
                name
        (Attribute(name, value))::(scanAttributes scanner)
    else [] 

// produces a text node and an end tag
let scanCDataContentAndEndTag(scanner:Scanner, tagName:string) =
    let m = scanner.scan(
                Regex(
                    String.Format("""
                \G # anchor at startpos
                (?<content>.*?)
                </{0}>""", tagName),
                    RegexOptions.ExplicitCapture ||| RegexOptions.IgnoreCase ||| RegexOptions.IgnorePatternWhitespace ||| RegexOptions.Singleline))
    let cdata = m.Groups.["content"].Value
    [TextToken(cdata); EndTag(tagName)] : Token list

let scanTag(scanner:Scanner, read) : Token list =
    let tagName = scanTagName(scanner)
    let atts = scanAttributes(scanner)
    consumeTagEnd(scanner)
    let tag = StartTag(tagName, atts)
    // special case for script and style tags
    match tagName with 
    | "script" | "style" -> (tag :> Token)::scanCDataContentAndEndTag(scanner, tagName)
    | _ -> [tag]

let scanEndTag(scanner:Scanner, read) =
    let tagName = scanTagName(scanner)
    consumeTagEnd(scanner)
    EndTag(tagName)

(*
    Scanner rules (reverse-ingeneered from browser):
        Text: everything until a <! or <\w or </ or end
        Comment: from '<!--' until first '-->' (no quoting or nesting)
        Directive: from '<!' until '>' (no quoting or nesting)
        Tag: from '<\w' or '</' until '>' - quoting supported in attribute values
*)


let scan (html:string) =
    let r = Regex("""
            (
              (?<comment><!--.*?-->)
            | (?<doctype><![^>]*>)       
            | (?<tagstart><(?=\w))    # consumes < but not tagname
            | (?<endtagstart></)    # consumes </ but not tagname
            | (?<text>.+?(?=($|<[/\w!])))
            )
        """, RegexOptions.ExplicitCapture ||| RegexOptions.IgnorePatternWhitespace ||| RegexOptions.Singleline)
    let rec scan1 (scanner:Scanner) (stack:Token list) =
        if scanner.atEnd()
        then stack
        else 
            let m = scanner.scan(r)
            if not (m.Success) then failwith "scan error"
            let produced = 
                if m.Groups.["comment"].Success || m.Groups.["doctype"].Success then []
                // TODO: should we ignore whitespace nodes?
                elif m.Groups.["text"].Success && String.IsNullOrWhiteSpace(m.Groups.["text"].Value) then []
                else 
                    if m.Groups.["tagstart"].Success then scanTag(scanner, m.Groups.["tagstart"].Value)                          
                    elif m.Groups.["endtagstart"].Success then [scanEndTag(scanner, m.Groups.["endtagstart"].Value) :> Token]
                    elif m.Groups.["text"].Success then 
                        let pcdata = m.Groups.["text"].Value
                        let cdata = (unescape pcdata).Trim()
                        [TextToken(cdata) :> Token]
                    else failwith "scan error"
            scan1 scanner (stack @ produced)

    let mutable scanner = Scanner(html)
    scan1 scanner []